#!/usr/bin/perl -w
#
#   Copyright (C) 2008 Dan White.
#   This software is distributed according to the terms of the GNU
#   Public License as found at
#   <URL:http://www.fsf.org/copyleft/gpl.html>.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.

# HTTP/1.1 200 OK
# Content-Type: text/html
#
# <html><body>Test</body></html>

use strict;
#use threads;
#use threads::shared;
use Getopt::Long;
use IO::File;
use IO::Socket;
use Config::IniFiles;
use Switch;
use Sys::Hostname;
#use Data::Dumper;
use IO::Socket::SSL;
use Expect;

my $server = hostname;
my ($helpOpt, $versionOpt, $debugOpt, $configOpt);
my $version = "0.1";
my $usage = <<'EOD'
Usage: omo-proto -c <filename> | --config=<filename> [ -d | --debug ]
       omo-proto -h | --help
       omo-proto -v | --version

  -c            The config file
    --config
  -h            This help screen
    --help
  -v            Print the version number
    --version
  -d            Include debug output
    --debug
EOD
;

my $options = GetOptions("h" => \$helpOpt,
                      "help" => \$helpOpt,
                      "v" => \$versionOpt,
                      "version" => \$versionOpt,
                      "c=s" => \$configOpt,
                      "config=s" => \$configOpt,
                      "d" => \$debugOpt,
                      "debug" => \$debugOpt);

die $usage unless @ARGV == 0;

if (!defined $configOpt) {
	print $usage;
	exit 1;
}

open (CONFIG, "<$configOpt") or die "$configOpt not found: $!\n";
close CONFIG;

my $cfg = Config::IniFiles->new( -file => $configOpt );

my $main_sock;

my $connection = $cfg->val('general', 'listen_on');
my $ssl_cert = $cfg->val('general', 'ssl_cert');
my $ssl_key = $cfg->val('general', 'ssl_key');
my $session_id = $cfg->val('general', 'session_id');
my $timeout = $cfg->val('general', 'timeout');
my $proxy_re = $cfg->val('general', 'proxy_re');
my $poll_re = $cfg->val('general', 'poll_re');
my $ssl_proxy_server = $cfg->val('general', 'ssl_proxy_server');

if ($connection =~ /tcp:(.+):([0-9]*)/) {
	my $local_addr = $1;
	my $local_port = $2;
	# If it's an IPv6 specification - tcp:[1:2:3:4:5:6]:80 -
	# strip out the brackets
	$local_addr =~ s/\[|\]//g;

    $main_sock = new IO::Socket::INET (
									LocalAddr => $local_addr,
									LocalPort => $local_port,
									Proto => 'tcp',
									Type => SOCK_STREAM,
									Listen => 65536,
									Reuse => 1,
                                  );
} elsif ($connection =~ /ssl:(.+):([0-9]*)/) {
	my $local_addr = $1;
	my $local_port = $2;
	$local_addr =~ s/\[|\]//g;

    $main_sock = new IO::Socket::SSL (
									LocalAddr => $local_addr,
									LocalPort => $local_port,
									Proto => 'tcp',
									Type => SOCK_STREAM,
									Listen => 65536,
									Reuse => 1,
									SSL_cert_file => $ssl_cert,
									SSL_key_file => $ssl_key,
                                  );
} elsif ($connection =~ /((unix)|(local)):(.+)/) {
    $main_sock = new IO::Socket::UNIX (
                                  Type => SOCK_STREAM,
                                  Local => $4,
								  Listen => 65536
                                  );
} else {
    die "unrecognized connection specification $connection";
}

die "Socket bind failure for $connection: $!\n" unless defined $main_sock;

my $new_sock;
my %sessions;
#my %conditions :shared;
#my %locks :shared;

sub send_to_clients {
	my (@message) = @_;

	#print "Entered send_to_clients: @message\n";

	my @recipients = grep(/^X-OMO-TO: /, @message); 
	for (@recipients) { $_ =~ s/^X-OMO-TO: (.*)/$1/; }

	my @actual_message = grep(!/^X-OMO-TO: /, @message);

	#print "Recipients: @recipients\n";
	print "Actual Message: @actual_message\n";

	for (@recipients) {
		print "Sending message to $_\n";
		if (not exists $sessions{$_}) { next; }
		my $fh = $sessions{$_};
		for (@actual_message) {
			print $fh "$_\n";
		}
		print $fh "DONE\n";
	}
}

while ($new_sock = $main_sock->accept()) {
	print "Just received a socket request.\n";
	my $session = "";
	my @message;
	my $is_a_get;

	my $first_line = <$new_sock>;
	if 
	while (<$new_sock>) {
		s/\r|\n//g;
		if (m/^GET/i) { $is_a_get=1; }
		push @message, $_;
		print "Received: $_\n";
		if ($_ eq "" and $is_a_get) { last; }
	}

	if (not $is_a_get) { send_to_clients(@message); next; }

	for (@message) {
		if (m/^Cookie.* $session_id=([^;]+|.*$)/) {
			$session = $1;
		}
	}

	if ($session eq "") {
		# Didn't find a session ID
		print "Didn't find a session id.\n";
		$new_sock->close(SSL_no_shutdown => 1);
		next;
	}

	print "session = $session\n";

	my $fh = IO::File->new();
	$sessions{$session} = $fh;

	$| = 1;

	my $pid = open($fh, "|-");

	$SIG{PIPE} = sub { print "SIGPIPE\n"; };

	my $oldh;

	if ($pid) {  # parent
		$oldh = select($fh);
		$| = 1;
		select($oldh);
		next;
		print "parent block, done printing to the FH handle.\n";
		next;
	}
	close $main_sock; # Not needed in the child

	print "Start of STDIN loop.\n";

#	my $exp = Expect->exp_init(\*STDIN);
#
#	#$patidx = $exp->expect($timeout, @match_patterns);
#
#	print "timeout = $timeout\n";
#LOOP:
#	my ($matched_pattern_position, $error, $successfully_matching_string, $before_match, $after_match) = $exp->expect($timeout,
#		#[ qr/^DONE\r$/ => sub { goto OUT; }
#		#],
#		[  
#			eof =>
#				sub {
#					;
#				}
#		],
#		[  
#			timeout =>
#				sub {
#					print "Timed out!\n";
#					print $new_sock "HTTP/1.1 204 No Content\n";
#					print $new_sock "\n";
#					goto OUT;
#				}
#		],
#		'-re', qr/.*\r?$/
#	);
#	print "Received (client): ___${successfully_matching_string}___\n";
#	print $new_sock "$successfully_matching_string\n";
#	goto LOOP;

	while (<STDIN>) {
		if (m/^DONE$/) {
			last;
		}
		print $new_sock $_;
	}

OUT:
	print "Got outside of STDIN loop.\n";
	$new_sock->close(SSL_no_shutdown => 1);
	exit;  # don't forget this

} continue {
    # parent closes the client since
    # it is not needed
	$new_sock->close(SSL_no_shutdown => 1);
}


=head1 NAME

  omo-proto -- OMO Perl Prototype

=head1 SYNOPSIS

  omo-proto [options]
    options:
	  --config=<filename>
	  --help
	  --version
	  --debug

=head1 DESCRIPTION

omo-proto...

=head1 EXAMPLE

	omo-proto --config=/etc/omo-proto.conf

=head1 WARNING

=head1 PERFORMANCE NOTES

=cut

